#-*- mode: perl; coding:utf-8 -*-
#Class Chart Library
#  Need GraphViz
use utf8;
use Encode;
package Cllib;


#############################################################################
#      Initialize 
#############################################################################
sub Initialize {
    $Debug = 1;
    $Debug && print "Cllib Initialize\n";

    # 作業領域初期化
    %Classes = ();                                          # Class定義
    %ClassIds = ();                                         # ClassId
    $NewId = 1;                                             # Id
    @Arrow = ();                                            # 関連

    #system coding system 
    $InCodingSystem = "shiftjis";                           # 
}

sub OutputDot {
    my ($OutDot) = @_;
    $Debug && print "Dot $OutDot \n";
    open(OUTDOT, ">:utf8", $OutDot)|| die "Can't open to $OutDot\n"; # FILEを開く(utf8)
    &InitializeDot();
    while (($name, $value) = each(%Classes)) {
        print OUTDOT "    $value\n";
    }
    foreach $arw (@Arrow) {
        print OUTDOT "    $arw\n";
    }
    &FinalizeDot();
    close(OUTDOT);
}

#############################################################################
#      ReadHeader(Dir, file name)
#############################################################################
sub ReadHeader {
    my ($dir, $name) = @_;
    my $curClass, $curMethod, $curProperty;
    $Path = "$dir/$name";
    open(FILE, "$dir/$name") || print "Cannot Open $dir/$name\n"; # ファイルを開く
    $Debug && printf("SOURCE FILE:$Path \n");
    
	while($_ = Encode::decode($InCodingSystem,<FILE>)) {
	    if ($_ =~ /^class\s+([A-Za-z0-9_]+)\s*\;/) {             # 前方定義
            &predefine($1);                                      # 
	    } elsif ($_ =~ /^class\s+(.*)$/) {     # クラス定義開始

            $curMethod = "";
            $curProperty = "";
            $classdef = $1;
            while (!eof(FILE) && $classdef !~ /\{/) {
                $classdef = $classdef . Encode::decode($InCodingSystem,<FILE>);
            }
            $classdef =~ s/\n/ /g;
            $classdef =~ s/\{.*$//;
            if ($classdef =~ /^([^\:]*)\:([^\:].*)$/) {
                $curClass = $1;
                $inherit = $2;
            } else {
                $curClass = $classdef;
                $inherit = "";
            }
            $Debug && print("#### $curClass / $inherit #####\n");
            my(@c) = split(/\s/,$curClass);
            $curClass = $c[$#c];
            if ($inherit) {
                my(@super) = split(/\,/,$inherit);
                while (@super) {
                    my($s) = shift(@super);
                    while (! &is_match_angle_bracket($s)) {
                        $s = $s . "," . shift(@super);
                    }
                    $s =~ s/^\s*public\s*//g;
                    $s =~ s/^\s*private\s*//g;
                    $s =~ s/^\s*protected\s*//g;
                    $s =~ s/[\s\n]//g;
                    if ($s) {
                        &AddRef($s, $curClass, "is a");
                    }
                }
            }
	    } elsif ($_ =~ /^\}\;/) {                                # Class End
            if ($curClass) {
                &define($curClass, $curMethod, $curProperty);
            }
            $curClass = "";
            $curMethod = "";
            $curProperty = "";
	    } elsif ($_ =~ /^\s+([a-zA-Z_]+)(.*)\/\/\s*\<\<(.*)\>\>/) { # 特徴点
            local ($type)= $1;
            local ($sep) = $2;
            local ($streo_type) = $3;
            if ($Classes{$type}) {
                if ($curClass ne "") {
                    &AddRef($curClass, $type, $streo_type);
                }
            } elsif ($_ =~ /([a-zA-Z_]+)\(/) { #method
                $curMethod .= "$1()\\l";
            } elsif ($_ =~ /^\s*([a-zA-Z_].+)\;/) {   #property
                $curProperty .= "$1\\l";
            }
	    } elsif ($_ =~ /^\s+([a-zA-Z_]+)(.)/) { # class 参照
	    }
	}
    close(FILE);
}

sub predefine {
    my ($class) = @_;
    &GetClassId($class);
}

sub IsClass {
    my ($type) = @_;
    return $Classes{$type};
}

sub define {
    my($class, $method, $property, $streo_type) = @_;
    $Debug && printf("define $class, $method, $property, $streo_type\n");

    my $id, $label;
    $id = &GetClassId($class);
    $label = &ClassLabel($class);
    if ($streo_type) {
        $label = "\\<\\<$streo_type\\>\\>\\n$label";
    }   
    if ($property ne "") {
        $Classes{$class} = "  $id [shape=record,label=\"{$label|$method|$property}\" ];";
    } elsif ($method ne "") {
        $Classes{$class} = "  $id [shape=record,label=\"{$label|$method}\"   ];";
    } else {
        $Classes{$class} = "  $id [shape=record,label=\"{$label}\" ];";
    }
}

sub AddRef {
    my($nameFrom, $nameTo, $type) = @_;
    $Debug && printf("$Path:$.:AddRef($type) $nameFrom, $nameTo /\n"); 

    my($classFrom, $classTo);
    $classFrom = &GetClassId($nameFrom);
    $classTo = &GetClassId($nameTo);
    if ($type =~ /is a/) {
        push(@Arrow, 
             "$classFrom -> $classTo [dir=\"back\", arrowtail=\"empty\"];\n");
    } elsif ($type =~ /has a/) {
        push(@Arrow, 
             "$classFrom -> $classTo [dir=\"back\", arrowtail=\"diamond\"];\n");
    } else {
        push(@Arrow, 
             "$classFrom -> $classTo [label=\"$type\" arrowhead=\"vee\"];\n");
    }
}

sub GetClassId {
    my ($class) = @_;
    my $id = $ClassIds{$class};
    unless ($id) {
        $id = $NewId++;
        $ClassIds{$class} = $id;
    }
    # class undefined -> define default
    if (! $Classes{$class}) { 
        my $label = &ClassLabel($class);
        $Classes{$class} = " $id [shape=record,label=\"{$label}\"];";
        $ClassIds{$class} = $id;
    }
    return $id;
}

sub ClassLabel {
    my ($class) = @_;
    $class =~ s/([\<\>])/\\$1/g;
    return $class;
}
sub InitializeDot {
    #header
    print OUTDOT <<END_OF_DATA;
digraph finite_state_machine {
   graph [nodesep = 0.7];
   node [shape = record, height = 0.01, style = filled, 
         fontname = "Helvetica", fontsize = 12,
         color = "#000000", fillcolor = "#CCCC66]"];

END_OF_DATA
}

sub FinalizeDot {
    #Footer
    print OUTDOT <<END_OF_DATA;
}
END_OF_DATA
}

sub remove_comment {
    my($line) = @_;
    
}

# <と>の個数が同じかどうかチェックする
sub is_match_angle_bracket {
    my ($s) = @_;
    my ($start) = ($s =~ s/\<//g );
    my ($end) = ($s =~ s/\>//g );
    
    return ($start == $end);
}

# dotが生成するSVGのサイズ単位がPTであるが，ブラウザで表示がおかしくなるため，
# PXに変換する．
sub SvgComvartPT {
    my ($file) = @_;

    #一括読み込み
    open(SVG, "<:utf8", $file) || die "Can't open to $file\n";
    my (@lines) = <SVG>;
    close(SVG);

    # 変換
    my ($i);
    for ($i = 0; $i <= $#lines; $i++) {
        @lines[$i] =~ s/pt\"/px\"/g;  
        @lines[$i] =~ s/pt\;\"/px\;\"/g;  
    }

    # 一括書き込み
    open(SVG, ">:utf8", $file) || die "Can't open to $file\n";
    foreach $l (@lines) {
        print SVG $l;
    }
    close(SVG);

}

#svg画像のサイズを取得(GraphViz出力のみ)
sub GetSvgSize {
   my ($file) = @_;
   my($l,$width,$height);

   #読み込み
   open(SVG, "<:utf8", $file) || die "Can't open to $file\n";
   while (!eof(SVG)) {
       $l =  <SVG>;
       # tag <svg width="602px" height="354px"
       if ($l =~ /\<[Ss][Vv][Gg]/) {
           while ($l !~ /\>/ && !eof(SVG)) {
               $l = $l . <SVG>;
           }
           last;
       }
   }
   $l =~ /[Ww][Ii][Dd][Tt][Hh]\s*\=\s*\"(\d*)/;
   $width = $1;
   $l =~ /[Hh][Ee][Ii][Gg][Hh][Tt]\s*\=\s*\"(\d*)/;
   $height = $1;
   close(SVG);
   return ($width, $height);
}

1;

